;; test-binary.scm: Binary protocol test routines for r6rs-thrift
;; Copyright (C) 2012 Julian Graham

;; r6rs-thrift is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

#!r6rs

(import (rnrs))
(import (srfi :64))
(import (thrift private))
(import (thrift protocol))
(import (thrift protocol binary))

(test-begin "binary")
(test-begin "serializer")

(define (make-test-struct)
  (let* ((struct-rtd (make-record-type-descriptor 
		      'test-struct thrift:struct #f #f #f #((immutable val))))
	 (struct-type-reference
	  (thrift:make-type-reference
	   "test-struct" "thrift default"
	   (thrift:make-struct-field-type-descriptor
	    "test-struct" "thrift default" struct-rtd
	    (list (thrift:make-field-descriptor 
		   1 "val" (thrift:make-type-reference 
			    "string" #f thrift:field-type-string) #f ""))
	    #f #f))))

    (thrift:struct-builder-build
     (thrift:make-struct-builder struct-type-reference))))

(test-group "write-message-begin"
  (let ((message (thrift:make-message "test" (thrift:message-type call) 0))
	(reference-vector (make-bytevector 16)))
    
    (bytevector-copy! #vu8(#x80 #x01 #x00 #x01) 0 reference-vector 0 4)
    (bytevector-copy! #vu8(#x00 #x00 #x00 #x04) 0 reference-vector 4 4)
    (bytevector-copy! (string->utf8 "test") 0 reference-vector 8 4)
    (bytevector-copy! (make-bytevector 4 #x00) 0 reference-vector 12 4)

    (let-values (((port get-bytevector) (open-bytevector-output-port)))
      ((thrift:serializer-write-message-begin
	(thrift:protocol-serializer thrift:binary-protocol)) port message)
      (test-assert (bytevector=? (get-bytevector) reference-vector)))))

(test-group "write-message-end"
  (let ((message (thrift:make-message "test" (thrift:message-type call) 0))
	(reference-vector (make-bytevector 16)))
    (let-values (((port get-bytevector) (open-bytevector-output-port)))
      ((thrift:serializer-write-message-end
	(thrift:protocol-serializer thrift:binary-protocol)) port message)
      (test-assert (eqv? (bytevector-length (get-bytevector)) 0)))))

(test-group "write-struct-begin"  
  (let-values (((port get-bytevector) (open-bytevector-output-port)))
    ((thrift:serializer-write-struct-begin
      (thrift:protocol-serializer thrift:binary-protocol)) 
     port (make-test-struct))
    (test-assert (eqv? (bytevector-length (get-bytevector)) 0))))

(test-group "write-struct-end"
  (let-values (((port get-bytevector) (open-bytevector-output-port)))
    ((thrift:serializer-write-struct-end
      (thrift:protocol-serializer thrift:binary-protocol)) 
     port (make-test-struct))
    (test-assert (eqv? (bytevector-length (get-bytevector)) 0))))

(test-group "write-field-begin"
  (let ((field (thrift:make-field
		(thrift:make-field-descriptor
		 1 "foo" (thrift:make-type-reference 
			  "i32" #f thrift:field-type-i32) #t 0)
		100)))
    (let-values (((port get-bytevector) (open-bytevector-output-port)))
      ((thrift:serializer-write-field-begin
	(thrift:protocol-serializer thrift:binary-protocol)) port field)
      (let ((bv (get-bytevector)))
	(test-assert (bytevector=? 
		      (u8-list->bytevector 
		       (list (thrift:wire-type->byte (thrift:wire-type i32)) 
			     #x00 #x01))
		      bv))))))

(test-group "write-field-end"
  (let ((field (thrift:make-field
		(thrift:make-field-descriptor
		 1 "bar" (thrift:make-type-reference 
			  "string" #f thrift:field-type-string) #t "")
		"test")))
    (let-values (((port get-bytevector) (open-bytevector-output-port)))
      ((thrift:serializer-write-field-end
	(thrift:protocol-serializer thrift:binary-protocol)) port field)
      (test-assert (eqv? (bytevector-length (get-bytevector)) 0)))))

(test-group "write-field-stop"
  (let-values (((port get-bytevector) (open-bytevector-output-port)))
    ((thrift:serializer-write-field-stop
      (thrift:protocol-serializer thrift:binary-protocol)) port)
    (test-assert (eqv? (bytevector-u8-ref (get-bytevector) 0) 
		       (thrift:wire-type->byte (thrift:wire-type stop))))))

(test-group "write-map-begin"
  (let* ((enum-type (thrift:make-enum-field-type-descriptor
		    "FooEnum" "thrift default" 'FALSE
		    (list (thrift:make-enum-value-descriptor "FALSE" 0)
			  (thrift:make-enum-value-descriptor "TRUE" 1))))
	 (mp (make-hashtable
	      (thrift:type->hash-function 
	       (thrift:make-type-reference 
		"FooEnum" "thrift default" enum-type))
	      (thrift:type->equivalence-function 
	       (thrift:make-type-reference 
		"FooEnum" "thrift default" enum-type)))))

    (hashtable-set! mp 'FALSE #f)
    (hashtable-set! mp 'TRUE #t)

    (let-values (((port get-bytevector) (open-bytevector-output-port)))
      ((thrift:serializer-write-map-begin
	(thrift:protocol-serializer thrift:binary-protocol)) 
       port mp enum-type thrift:field-type-bool)
      (test-assert (bytevector=?
		    (u8-list->bytevector 
		     (list (thrift:wire-type->byte (thrift:wire-type enum))
		           (thrift:wire-type->byte (thrift:wire-type bool)) 
			   #x00 #x00 #x00 #x02))
		    (get-bytevector))))))
			     
(test-group "write-map-end"
  (let* ((enum-type (thrift:make-enum-field-type-descriptor
		     "FooEnum" "thrift default" 'FALSE
		     (list (thrift:make-enum-value-descriptor "FALSE" 0)
			   (thrift:make-enum-value-descriptor "TRUE" 1))))
	 (mp (make-hashtable 
	      (thrift:type->hash-function 
	       (thrift:make-type-reference 
		"FooEnum" "thrift default" enum-type))
	      (thrift:type->equivalence-function 
	       (thrift:make-type-reference
		"FooEnum" "thrift default" enum-type)))))
    
    (hashtable-set! mp 'FALSE #f)
    (hashtable-set! mp 'TRUE #t)
    
    (let-values (((port get-bytevector) (open-bytevector-output-port)))
      ((thrift:serializer-write-map-end
	(thrift:protocol-serializer thrift:binary-protocol)) 
       port mp enum-type thrift:field-type-bool)
      (test-assert (eqv? (bytevector-length (get-bytevector)) 0)))))

(test-group "write-list-begin"
  (let ((lst #("foo" "bar" "baz")))
    (let-values (((port get-bytevector) (open-bytevector-output-port)))
      ((thrift:serializer-write-list-begin
	(thrift:protocol-serializer thrift:binary-protocol)) 
       port lst thrift:field-type-string)
      (test-assert (bytevector=? 
		    (u8-list->bytevector 
		     (list (thrift:wire-type->byte (thrift:wire-type string)) 
			   #x00 #x00 #x00 #x03))
		    (get-bytevector))))))

(test-group "write-list-end"
  (let ((lst #("foo" "bar" "baz")))	    
    (let-values (((port get-bytevector) (open-bytevector-output-port)))
      ((thrift:serializer-write-list-end
	(thrift:protocol-serializer thrift:binary-protocol)) 
       port lst thrift:field-type-string)
      (test-assert (eqv? (bytevector-length (get-bytevector)) 0)))))

(test-group "write-set-begin"
  (let ((set '(1 2 3 4 5 6)))
    (let-values (((port get-bytevector) (open-bytevector-output-port)))
      ((thrift:serializer-write-set-begin
	(thrift:protocol-serializer thrift:binary-protocol)) 
       port set thrift:field-type-i16)
      (test-assert (bytevector=? 
		    (u8-list->bytevector 
		     (list (thrift:wire-type->byte (thrift:wire-type i16)) 
			   #x00 #x00 #x00 #x06))
		    (get-bytevector))))))

(test-group "write-set-end"
  (let ((set '(1 2 3 4 5 6)))	    
    (let-values (((port get-bytevector) (open-bytevector-output-port)))
      ((thrift:serializer-write-set-end
	(thrift:protocol-serializer thrift:binary-protocol)) 
       port set thrift:field-type-i16)
      (test-assert (eqv? (bytevector-length (get-bytevector)) 0)))))

(test-group "write-bool"

  (let-values (((port get-bytevector) (open-bytevector-output-port)))
    ((thrift:serializer-write-bool
      (thrift:protocol-serializer thrift:binary-protocol)) port #t)
    (test-assert (eqv? (bytevector-u8-ref (get-bytevector) 0) #x01)))

  (let-values (((port get-bytevector) (open-bytevector-output-port)))
    ((thrift:serializer-write-bool
      (thrift:protocol-serializer thrift:binary-protocol)) port #f)
    (test-assert (eqv? (bytevector-u8-ref (get-bytevector) 0) #x00))))

(test-group "write-byte"
  (let-values (((port get-bytevector) (open-bytevector-output-port)))
    ((thrift:serializer-write-byte
      (thrift:protocol-serializer thrift:binary-protocol)) port #x7f)
    (test-assert (eqv? (bytevector-u8-ref (get-bytevector) 0) #x7f))))

(test-group "write-i16"
  (let-values (((port get-bytevector) (open-bytevector-output-port)))
    ((thrift:serializer-write-i16
      (thrift:protocol-serializer thrift:binary-protocol)) port 16384)
    (test-assert (eqv? (bytevector-sint-ref 
			(get-bytevector) 0 (endianness big) 2) 
		       16384))))

(test-group "write-i32"
  (let-values (((port get-bytevector) (open-bytevector-output-port)))
    ((thrift:serializer-write-i32
      (thrift:protocol-serializer thrift:binary-protocol)) port 1073741824)
    (test-assert (eqv? (bytevector-sint-ref 
			(get-bytevector) 0 (endianness big) 4) 
		       1073741824))))

(test-group "write-i64"
  (let-values (((port get-bytevector) (open-bytevector-output-port)))
    ((thrift:serializer-write-i64
      (thrift:protocol-serializer thrift:binary-protocol)) 
     port 461168601842739)
    (test-assert (eqv? (bytevector-sint-ref
			(get-bytevector) 0 (endianness big) 8) 
		       461168601842739))))

(test-group "write-double"
  (let ((reference-vector (make-bytevector 8)))
    (bytevector-ieee-double-set! reference-vector 0 123.456 (endianness big))
    (let-values (((port get-bytevector) (open-bytevector-output-port)))
      ((thrift:serializer-write-double
	(thrift:protocol-serializer thrift:binary-protocol)) port 123.456)
      (test-assert (bytevector=? reference-vector (get-bytevector))))))

(test-group "write-string"
  (let-values (((port get-bytevector) (open-bytevector-output-port)))
    ((thrift:serializer-write-string
      (thrift:protocol-serializer thrift:binary-protocol)) port "abcd")
    (test-assert (bytevector=? (u8-list->bytevector 
				'(#x00 #x00 #x00 #x04 #x61 #x62 #x63 #x64))
			       (get-bytevector)))))

(test-end "serializer")

(test-begin "deserializer")

(test-group "read-message-begin"
  (let ((bv (make-bytevector 16)))
    (bytevector-copy! #vu8(#x80 #x01 #x00 #x01) 0 bv 0 4)
    (bytevector-copy! #vu8(#x00 #x00 #x00 #x04) 0 bv 4 4)
    (bytevector-copy! (string->utf8 "test") 0 bv 8 4)
    (bytevector-copy! (make-bytevector 4 #x00) 0 bv 12 4)
    (let ((port (open-bytevector-input-port bv)))
      (let-values (((name message-type size)
		    ((thrift:deserializer-read-message-begin
		      (thrift:protocol-deserializer thrift:binary-protocol))
		     port)))
	(test-assert (equal? name "test"))
	(test-assert (eq? message-type (thrift:message-type call)))
	(test-assert (eqv? size 0))))))

(test-group "read-message-end"
  (let* ((message (thrift:make-message "test" (thrift:message-type call) 0))
	 (bv (make-bytevector 0))
	 (port (open-bytevector-input-port bv)))
    (test-assert (eq? ((thrift:deserializer-read-message-end
			(thrift:protocol-deserializer thrift:binary-protocol))
		       port message)
		      message))))

(test-group "read-struct-begin"
  (let* ((bv (make-bytevector 0))
	 (port (open-bytevector-input-port bv)))
    ((thrift:deserializer-read-struct-begin
      (thrift:protocol-deserializer thrift:binary-protocol)) port)
    (test-assert #t)))

(test-group "read-struct-end"
  (let* ((bv (make-bytevector 0))
	 (port (open-bytevector-input-port bv))
	 (struct (make-test-struct)))
    (test-assert (eq? ((thrift:deserializer-read-struct-end
			(thrift:protocol-deserializer thrift:binary-protocol))
		       port struct)
		      struct))))

(test-group "read-field-begin"
  (let* ((bv (u8-list->bytevector 
	      (list (thrift:wire-type->byte (thrift:wire-type i64)) 
		    #x00 #x08)))
	 (port (open-bytevector-input-port bv)))
    (let-values (((wire-type ordinal)
		  ((thrift:deserializer-read-field-begin
		    (thrift:protocol-deserializer thrift:binary-protocol))
		   port)))
      (test-assert (eq? wire-type (thrift:wire-type i64)))
      (test-assert (eqv? ordinal 8)))))

(test-group "read-field-end"
  (let* ((f (thrift:make-field
	     (thrift:make-field-descriptor 
	      1 "foo" (thrift:make-type-reference 
		       "i32" #f thrift:field-type-i32) #t 0)
	     100))
	 (bv (make-bytevector 0))
	 (port (open-bytevector-input-port bv)))
    (test-assert (eq? ((thrift:deserializer-read-field-end 
			(thrift:protocol-deserializer thrift:binary-protocol))
		       port f)
		      f))))

(test-group "read-map-begin"
  (let* ((bv (u8-list->bytevector 
	      (list (thrift:wire-type->byte (thrift:wire-type i32))
		    (thrift:wire-type->byte (thrift:wire-type struct))
		    #x00 #x00 #x00 #xff)))
	 (port (open-bytevector-input-port bv)))
    (let-values (((key-wire-type value-wire-type size) 
		  ((thrift:deserializer-read-map-begin
		    (thrift:protocol-deserializer thrift:binary-protocol))
		   port)))
      (test-assert (eq? key-wire-type (thrift:wire-type i32)))
      (test-assert (eq? value-wire-type (thrift:wire-type struct)))
      (test-assert (eqv? size 255)))))		   

(test-group "read-map-end"
  (let* ((m (make-eq-hashtable))
	 (bv (make-bytevector 0))
	 (port (open-bytevector-input-port bv)))
    (test-assert (eq? ((thrift:deserializer-read-map-end 
			(thrift:protocol-deserializer thrift:binary-protocol))
		       port m)
		      m))))

(test-group "read-list-begin"
  (let* ((bv (u8-list->bytevector 
	      (list (thrift:wire-type->byte (thrift:wire-type string))
		    #x00 #x00 #x00 #x0f)))
	 (port (open-bytevector-input-port bv)))
    (let-values (((wire-type size)
		  ((thrift:deserializer-read-list-begin
		    (thrift:protocol-deserializer thrift:binary-protocol))
		   port)))
      (test-assert (eq? wire-type (thrift:wire-type string)))
      (test-assert (eqv? size 15)))))

(test-group "read-list-end"
  (let* ((v (make-vector 0))
	 (bv (make-bytevector 0))
	 (port (open-bytevector-input-port bv)))
    (test-assert (eq? ((thrift:deserializer-read-list-end 
			(thrift:protocol-deserializer thrift:binary-protocol))
		       port v)
		      v))))

(test-group "read-list-begin"
  (let* ((bv (u8-list->bytevector 
	      (list (thrift:wire-type->byte (thrift:wire-type enum))
		    #x00 #x00 #x00 #x02)))
	 (port (open-bytevector-input-port bv)))
    (let-values (((wire-type size)
		  ((thrift:deserializer-read-set-begin
		    (thrift:protocol-deserializer thrift:binary-protocol))
		   port)))
      (test-assert (eq? wire-type (thrift:wire-type enum)))
      (test-assert (eqv? size 2)))))

(test-group "read-set-end"
  (let* ((s (list))
	 (bv (make-bytevector 0))
	 (port (open-bytevector-input-port bv)))
    (test-assert (eq? ((thrift:deserializer-read-set-end 
			(thrift:protocol-deserializer thrift:binary-protocol))
		       port s)
		      s))))

(test-group "read-bool"

  (let* ((bv (make-bytevector 1 #x01))
	 (port (open-bytevector-input-port bv)))
    (test-assert (eqv? ((thrift:deserializer-read-bool
			 (thrift:protocol-deserializer thrift:binary-protocol))
			port)
		       #t)))

  (let* ((bv (make-bytevector 1 #x00))
	 (port (open-bytevector-input-port bv)))
    (test-assert (eqv? ((thrift:deserializer-read-bool
			 (thrift:protocol-deserializer thrift:binary-protocol))
			port)
		       #f))))

(test-group "read-byte"
  (let* ((bv (make-bytevector 1 #x7f))
	 (port (open-bytevector-input-port bv)))
    (test-assert (eqv? ((thrift:deserializer-read-byte
			 (thrift:protocol-deserializer thrift:binary-protocol))
			port)
		       #x7f))))

(test-group "read-i16"
  (let* ((bv (make-bytevector 2))
	 (port (open-bytevector-input-port bv)))
    (bytevector-sint-set! bv 0 -32768 (endianness big) 2)
    (test-assert (eqv? ((thrift:deserializer-read-i16
			 (thrift:protocol-deserializer thrift:binary-protocol))
			port)
		       -32768))))


(test-group "read-i32"
  (let* ((bv (make-bytevector 4))
	 (port (open-bytevector-input-port bv)))
    (bytevector-sint-set! bv 0 -2147483648 (endianness big) 4)
    (test-assert (eqv? ((thrift:deserializer-read-i32
			 (thrift:protocol-deserializer thrift:binary-protocol))
			port)
		       -2147483648))))

(test-group "read-i64"
  (let* ((bv (make-bytevector 8))
	 (port (open-bytevector-input-port bv)))
    (bytevector-sint-set! bv 0 9223372036854775807 (endianness big) 8)
    (test-assert (eqv? ((thrift:deserializer-read-i64
			 (thrift:protocol-deserializer thrift:binary-protocol))
			port)
		       9223372036854775807))))

(test-group "read-double"
  (let* ((bv (make-bytevector 8))
	 (port (open-bytevector-input-port bv)))
    (bytevector-ieee-double-set! bv 0 123.456 (endianness big))
    (test-assert (eqv? ((thrift:deserializer-read-double
			 (thrift:protocol-deserializer thrift:binary-protocol))
			port)
		       123.456))))

(test-group "read-string"
  (let* ((bv (u8-list->bytevector '(#x00 #x00 #x00 #x03 #x66 #x6f #x6f)))
	 (port (open-bytevector-input-port bv)))
    (test-assert (equal? ((thrift:deserializer-read-string
			   (thrift:protocol-deserializer 
			    thrift:binary-protocol))
			  port)
			 "foo"))))

(test-end "deserializer")

(test-end "binary")
